home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / util / misc / Fudgit233.lha / Source / src / setshow.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-12-16  |  9.4 KB  |  329 lines
  1. #include <ctype.h>
  2. #include <string.h>
  3. #include <stdio.h>
  4. #ifndef NOMALLOC_H
  5. #include <malloc.h>
  6. #endif
  7. #ifndef NOUNISTD_H
  8. #include <unistd.h>
  9. #endif
  10.  
  11. #include "fudgit.h"
  12. #include "symbol.h"
  13. #include "macro.h"
  14. #include "code.h"
  15. #include "math.tab.h"
  16. #include "functions.h"
  17. #include "head.h"
  18.  
  19. /* All the global internal variables  */
  20. int Ft_Iter = 0;
  21. int Ft_Mlist = 0;
  22. int Ft_Mode = 0;
  23. double *Ft_A = NULL;
  24. double *Ft_DA = NULL;
  25. double *Ft_Mfparx1 = NULL;
  26. int *Ft_Miparx1 = NULL;
  27. double **Ft_M1parxpar = NULL;
  28. double **Ft_M2parxpar = NULL;
  29. double **Ft_Mparxsamp = NULL;
  30. double Ft_Q = 0.0;
  31. double Ft_Cortest[3];
  32. int Ft_Samples = 0;
  33. int Ft_Debug = 0;
  34. int Ft_Check = INF_CHK | NAN_CHK | EDOM_CHK | ERANGE_CHK;
  35. int Ft_Expandhist = 1;
  36. int Ft_Dolevel = 0;
  37. double *Ft_X2;
  38. double *Ft_Data;
  39. double *Ft_If_value;
  40. double *Ft_Param;
  41.  
  42. FILE *Ft_Inread;
  43. FILE *Ft_Outprint;
  44. char Ft_Outname[TOKENSIZE+8];
  45. char Ft_Inname[TOKENSIZE+8];
  46. char Ft_Home[PATH_MAXIM+4];
  47. char Ft_Shell[TOKENSIZE+8];
  48. char Ft_Pager[TOKENSIZE+8];
  49. char Ft_Prompt_cm[MAXPROMPT+4];
  50. char Ft_Prompt_fm[MAXPROMPT+4];
  51. char Ft_Prompt_pm[MAXPROMPT+4];
  52. char Ft_Format[TOKENSIZE+8];
  53. char Ft_TFormat[TOKENSIZE+8];
  54. char Ft_Vformat[TOKENSIZE+8];
  55. char Ft_UFunction[MAXMACRO+8] = { '\0' };
  56. char Ft_Pname[TOKENSIZE+8] = { '\0' };
  57. char Ft_ReadFile[TOKENSIZE+8];
  58. char Ft_Cwd[PATH_MAXIM];
  59. char Ft_Tmp[TOKENSIZE+8];
  60. char *Ft_Plotting[MAXPARG];
  61. char Ft_Comchar;
  62. int Ft_Methi;
  63. int Ft_Funci;
  64.  
  65. Meth Ft_Method[METHNUM] = {
  66.     {"none", "none"},
  67.     {"ls_r!eg", "least square linear regression"},
  68.     {"lad!_reg", "least absolute deviation linear regression"},
  69.     {"ls_f!it", "least square linear fit"},
  70.     {"sv!d_fit", "singular value decomposition linear fit"},
  71.     {"ml!_fit", "Marquardt-Levenberg non-linear fit"}
  72. };
  73.  
  74. Func Ft_Function[FUNCNUM] = {
  75.     {"none", "none"},
  76.     {"str!aight", "straight line"},
  77.     {"po!lynomial", "polynomial"},
  78.     {"leg!endre", "Legendre polynomial"},
  79.     {"si!ne", "sine series"},
  80.     {"cos!ine", "cosine series"},
  81.     {"ex!ponential", "exponential series"},
  82.     {"gau!ssian", "gaussian series"},
  83.     {"us!er", "user defined function"}
  84. };
  85.  
  86. extern double *Ft_dvector(int nl, int nh);
  87. extern double **Ft_dmatrix(int nrl, int nrh, int ncl, int nch);
  88. extern void Ft_free_dvector(double *v, int nl, int nh);
  89. extern void Ft_free_dmatrix(double **m, int nrl, int nrh, int ncl, int nch);
  90. extern void Ft_free_ivector(int *v, int nl, int nh);
  91. extern int *Ft_ivector(int nl, int nh);
  92. extern int Ft_exit(int);
  93. extern int Ft_symremove (char *name, int verb);
  94.  
  95. int Ft_initsetup(void)
  96. {
  97.     Symbol *sym, *Ft_lookup(char *);
  98.     char *cp, *getenv(const char *);
  99.     int i;
  100.  
  101.     sym = Ft_lookup("Cwd");
  102.     sym->u.str = Ft_Cwd;
  103.     sym = Ft_lookup("ReadFile");
  104.     sym->u.str = Ft_ReadFile;
  105.     sprintf(Ft_ReadFile, "none");
  106.     sym = Ft_lookup("Tmp");
  107. #ifdef AMIGA
  108.     sprintf(Ft_Tmp, "t:fudgit%d", getpid());
  109. #else
  110.     sprintf(Ft_Tmp, "/tmp/fudgit%d", getpid());
  111. #endif
  112.     sym->u.str = Ft_Tmp;
  113.     if ((cp = getenv("PAGER")))
  114.         sprintf(Ft_Pager, "%s", cp);
  115.     else
  116.         sprintf(Ft_Pager, "%s", DEFPAGER);
  117.     if ((cp = getenv("SHELL")))
  118.         sprintf(Ft_Shell, "%s", cp);
  119.     else
  120.         sprintf(Ft_Shell, "%s", DEFSHELL);
  121.     if ((cp = getenv("HOME")))
  122.         sprintf(Ft_Home, "%s", cp);
  123.     else {
  124. #ifdef AMIGA
  125.         sprintf(Ft_Home, "./");
  126. #else
  127.         fputs("Fatal: Could not find home directory!\n", stderr);
  128.         Ft_exit(1);
  129. #endif
  130.     }
  131.     sprintf(Ft_Format, "%s", FORMAT);
  132.     sprintf(Ft_TFormat, "\t%s", FORMAT);
  133.     sprintf(Ft_Vformat, "%s", VFORMAT);
  134.     sprintf(Ft_Prompt_cm, "%s", PROMPT_CM);
  135.     sprintf(Ft_Prompt_fm, "%s", PROMPT_FM);
  136.     sprintf(Ft_Prompt_pm, "%s", PROMPT_PM);
  137.     for (i=0;i<MAXPARG-1;i++) {
  138.         if ((Ft_Plotting[i] = (char *)calloc(TOKENSIZE+1, 1)) == NULL) {
  139.             fputs("Fatal: Allocation error.\n", stderr);
  140.             Ft_exit(1);
  141.         }
  142.     }
  143.     sprintf(Ft_Plotting[0], "%s", PLOTTING);
  144.     Ft_Plotting[1][0] = '\0';
  145.     Ft_Comchar = '#';
  146.     Ft_Samples = MAXPTS;
  147.     sym = Ft_lookup("data");
  148.     Ft_Data = &(sym->u.val);
  149.     sym = Ft_lookup("chi2");
  150.     Ft_X2 = &(sym->u.val);
  151.     sym = Ft_lookup("param");
  152.     Ft_Param = &(sym->u.val);
  153.     sym = Ft_lookup("if_value");
  154.     Ft_If_value = &(sym->u.val);
  155.     Ft_Methi = 0;
  156.     Ft_Funci = 0;
  157.     Ft_Iter = ITER;
  158.     Ft_Outprint = stdout;
  159.     Ft_Inread = stdin;
  160.     strcpy(Ft_Outname, "stdout");
  161.     strcpy(Ft_Inname, "stdin");
  162.  
  163.     return(0);
  164. }
  165.  
  166. /* defines the name and number of parameters  */
  167. int Ft_setparam(char *name, int n)
  168. {
  169.     int i;
  170.     char dname[TOKENSIZE+6];
  171.     Symbol *sym;
  172.     extern Symbol *Ft_install(char *, int, int);
  173.  
  174.     if (!isupper((int)*name)) {
  175.         fprintf(stderr, "%s: Illegal vector name.\n", name);
  176.         return(ERRR);
  177.     }
  178.     for (i=1;i<strlen(name);i++) {
  179.         if (!isupper((int)name[i]) || !isdigit((int)name[i]))  {
  180.             fprintf(stderr, "%s: Illegal vector name.\n", name);
  181.             return(ERRR);
  182.         }
  183.     }
  184.     if (strlen(Ft_Pname)) {
  185.         sprintf(dname, "D%s", Ft_Pname);
  186.         Ft_symremove(Ft_Pname, 0);
  187.         Ft_symremove(dname, 0);
  188.     }
  189.     sprintf(Ft_Pname, "%s", name);
  190.     sym = Ft_install(Ft_Pname, PARAM, n);
  191.     Ft_A = sym->u.vec;
  192.     sprintf(dname, "D%s", Ft_Pname);
  193.     sym = Ft_install(dname, PARAM, n);
  194.     Ft_DA = sym->u.vec;
  195.     /* Allocate internal matrices */
  196.     if (Ft_Mfparx1 != (double *)NULL) {
  197.         Ft_free_dvector(Ft_Mfparx1, 1, (int) *Ft_Param);
  198.     }
  199.     if ((Ft_Mfparx1 = Ft_dvector(1, n)) == (double *)NULL) {
  200.         return(ERRR);
  201.     }
  202.     if (Ft_Miparx1 != (int *)NULL) {
  203.         Ft_free_ivector(Ft_Miparx1, 1, (int) *Ft_Param);
  204.     }
  205.     if ((Ft_Miparx1 = Ft_ivector(1, n)) == (int *)NULL) {
  206.         return(ERRR);
  207.     }
  208.     if (Ft_M1parxpar != (double **)NULL) {
  209.         Ft_free_dmatrix(Ft_M1parxpar, 1, (int) *Ft_Param, 1, (int) *Ft_Param);
  210.     }
  211.     if ((Ft_M1parxpar = Ft_dmatrix(1, n, 1, n)) == (double**)NULL) {
  212.         return(ERRR);
  213.     }
  214.     if (Ft_M2parxpar != (double **)NULL) {
  215.         Ft_free_dmatrix(Ft_M2parxpar, 1, (int) *Ft_Param, 1, (int) *Ft_Param);
  216.     }
  217.     if ((Ft_M2parxpar = Ft_dmatrix(1, n, 1, n)) == (double**)NULL) {
  218.         return(ERRR);
  219.     }
  220.     if (Ft_Mparxsamp != (double **)NULL) {
  221.         free(Ft_Mparxsamp+1);
  222.     }
  223.     /* Make my own matrix skeleton */
  224.     Ft_Mparxsamp = (double **)malloc((unsigned)n*sizeof(double *));
  225.     if (Ft_Mparxsamp == (double **)NULL) {
  226.         fputs("set parameters: Allocation error.\n", stderr);
  227.         return(ERRR);
  228.     }
  229.     Ft_Mparxsamp--;
  230.        
  231.     *Ft_Param = n;
  232.     Ft_Mlist = 0;
  233.     return(0);
  234. }
  235.  
  236. int Ft_showsetup(void)
  237. {
  238.     int i = 0;
  239.  
  240.     fprintf(stdout, "%28s: \"%s\"\n", "ReadFile", Ft_ReadFile);
  241.     fprintf(stdout, "%28s: %s\n",
  242.     "Fitting method", Ft_Method[Ft_Methi].name);
  243.     fprintf(stdout, "%28s: \"%d\"\n", "Iteration number", Ft_Iter);
  244.     fprintf(stdout, "%28s: %s\n",
  245.     "Function to fit", Ft_Function[Ft_Funci].name);
  246.     fprintf(stdout, "%28s: %d\n", "Number of parameters", (int) *Ft_Param);
  247.     fprintf(stdout, "%28s: %d points\n", "Current capacity", Ft_Samples);
  248.     fprintf(stdout, "%28s: %d\n", "Number of data points", (int) *Ft_Data);
  249.     fprintf(stdout, "%28s: ", "Plotting program");
  250.     while (Ft_Plotting[i][0]) {
  251.         fprintf(stdout, "%s ", Ft_Plotting[i]);
  252.         i++;
  253.     }
  254.     fputc('\n', stdout);
  255.     fprintf(stdout, "%28s: %s\n", "Pager program", Ft_Pager);
  256.     fprintf(stdout, "%28s: \"%s\"\n", "Output format", Ft_Format);
  257.     fprintf(stdout, "%28s: '%c'\n", "Comment character", Ft_Comchar);
  258.     fprintf(stdout, "%28s: \"%s\"\n", "Temporary file", Ft_Tmp);
  259.     return(0);
  260. }
  261.  
  262. int Ft_showfit(void)
  263. {
  264.     int i, j;
  265.  
  266.     if ((int) *Ft_Param == 0) {
  267.         fprintf(stderr, "No parameter!\n");
  268.         return(ERRR);
  269.     }
  270.     for (i=1;i <= (int) *Ft_Param;i++) {
  271.         fprintf(stdout, "\t%s[%d]: ", Ft_Pname, i);
  272.         fprintf(stdout, Ft_Format, Ft_A[i]);
  273.         fputs("\t +/- ", stdout);
  274.         fprintf(stdout, Ft_Format, Ft_DA[i]);
  275.         fputc('\n', stdout);
  276.     }
  277.     if (Ft_Methi == LA_REG) {
  278.         fputs("Mean absolute deviation: ", stdout);
  279.         fprintf(stdout, Ft_Format, *Ft_X2);
  280.         fputc('\n', stdout);
  281.     }
  282.     else {
  283.         fputs("Chi 2: ", stdout);
  284.         fprintf(stdout, Ft_Format, *Ft_X2);
  285.         fputc('\n', stdout);
  286.     }
  287.     if (Ft_Methi == LS_REG) {
  288.         fputs("Goodness-of-fit probability: ", stdout);
  289.         fprintf(stdout, Ft_Format, Ft_Q);
  290.         fputc('\n', stdout);
  291.     }
  292.     if (Ft_Mlist) {
  293.         fputs("Adjusting:", stdout);
  294.         for (i=1; i<= Ft_Mlist; i++) {
  295.             fprintf(stdout, " %d", Ft_Miparx1[i]);
  296.         }
  297.         fputc('\n', stdout);
  298.     }
  299.     if (Ft_Methi == ML_FIT || Ft_Methi == SVD_FIT || Ft_Methi == LS_FIT) {
  300.         fputs("Covariance matrix:\n", stdout);
  301.         for (i=1;i<= (int) *Ft_Param;i++) {
  302.             fputs(" |", stdout);
  303.             for (j=1;j<= (int) *Ft_Param;j++) {
  304.                 fprintf(stdout, "\t% 10.8e", Ft_M1parxpar[i][j]);
  305.             }
  306.             fputs("\t |\n", stdout);
  307.         }
  308.     }
  309.     if (Ft_Methi == ML_FIT) {
  310.         fputs("Curvature matrix:\n", stdout);
  311.         for (i=1;i<= (int) *Ft_Param;i++) {
  312.             fputs(" |", stdout);
  313.             for (j=1;j<= (int) *Ft_Param;j++) {
  314.                 fprintf(stdout, "\t% 10.8e", Ft_M2parxpar[i][j]);
  315.             }
  316.             fputs("\t |\n", stdout);
  317.         }
  318.     }
  319.     if (Ft_Methi == LS_REG || Ft_Methi == LA_REG) {
  320.         fputs("Linear correlation tests\n", stdout);
  321.         fprintf(stdout, "Correlation coefficient: %g\n", Ft_Cortest[0]);
  322.         fprintf(stdout, "Fisher's `z' coefficient: %g\n", Ft_Cortest[2]);
  323.         fprintf(stdout, "Significance: %g\n", Ft_Cortest[1]);
  324.     }
  325.  
  326.     fputc('\n', stdout);
  327.     return(0);
  328. }
  329.